home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / Jiggggler / Jiggler.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-28  |  7KB  |  277 lines
  1. Program Jiggggler;
  2. {$F-,I+,R+,S+,V+,M 3,1,1,1}
  3.  
  4. Uses 
  5.     AmigaDos, Exec, Intuition, Graphics, Icon, Amiga, Workbench, 
  6.     Commodities, CStrCOnstPtr, Timer, Input;
  7.     
  8. Type
  9.     tProgVars = Record
  10.         arg_Delay : LONG;
  11.         arg_HotKey : String;
  12.         arg_Pri,
  13.         arg_CxPri,
  14.         arg_Off    : LONG;
  15.     End;
  16.     
  17. Var
  18.     v : tProgVars;
  19.     CxPort, timerport, iport : pMsgPort;
  20.     broker, filter, translate, sender : pCxObj;
  21.     tio : ptimerequest;
  22.     ior : pIORequest;
  23.     
  24. {$I ToolType.PAS }
  25. {$I Version.H }
  26.  
  27.  
  28. Function InitCx : Boolean;
  29.  
  30. Var
  31.     rk : pRemember;
  32.     nb : tNewBroker;
  33.     r  : LONG;
  34.  
  35. Begin
  36.     InitCx := False;
  37.     rk := NIL;
  38.     Cxport := CreateMsgPort;
  39.     if Cxport <> NIL then begin
  40.         { watch this Pascalians ;^). if you put : }
  41.         { With nb do begin                        }
  42.         {   nb_Version := NB_VERSION              }
  43.         { end;                                    }
  44.         { you will not get any messages from Cx   }
  45.         { because you are assigning the field     }
  46.         { nb_Version to the field nb_version and  }
  47.         { not the NB_VERSION constant             }
  48.             
  49.         nb.nb_Version := NB_VERSION;
  50.         With nb do begin
  51.             nb_Name   := @CX_NAME[1];
  52.             nb_Title  := @CX_TITLE[1];
  53.             nb_Descr  := @CX_DESCR[1];
  54.             nb_Unique := 0;
  55.             nb_Flags  := 0;
  56.             nb_Pri    := V.arg_CxPri;
  57.             nb_Port   := CxPort;
  58.             nb_ReservedChannel := 0;
  59.         end;
  60.         Broker := CxBroker(@nb, NIL);
  61.         If broker <> NIL then begin
  62.             Filter := CxFilter(CSCPAR(@rk, V.arg_Hotkey));
  63.             if filter <> NIL then begin
  64.                 AttachCxObj(broker,filter);
  65.                 Sender := CxSender(CxPort, 0);
  66.                 If sender <> NIL then begin
  67.                     AttachCxObj(filter, sender);
  68.                     translate := CxTranslate(NIL);
  69.                     if translate <> NIL then begin
  70.                         AttachCxObj(filter, translate);
  71.                         
  72.                         if (CxObjError(filter) = 0) then begin
  73.                             r := ActivateCxObj(broker, 1);
  74.                             InitCx := True;
  75.                         End;
  76.                     End;
  77.                 End;
  78.             End;
  79.         End;
  80.     End;
  81.     FreeRemember(@rk, True);
  82. End;
  83.  
  84. Procedure RemoveCx;
  85.  
  86. Var
  87.     msg : pMessage;
  88.     
  89. Begin
  90.     DeleteCxObjAll(broker);
  91.     { clear the port of any last minute messages }
  92.     Msg := GetMsg(Cxport);
  93.     While msg <> NIL do begin
  94.         ReplyMsg(msg);
  95.         Msg := GetMsg(Cxport);
  96.     end;
  97.     { remove the port }
  98.     DeleteMsgPort(CxPort);
  99. end;
  100.  
  101. Function InitTimer : Boolean;
  102.  
  103. Begin
  104.     Inittimer := false;
  105.     TimerPort := CreateMsgPort;
  106.     If timerport <> NIL then begin
  107.         tio := pTimeRequest(CreateIORequest(TimerPort, sizeof(ttimerequest)));
  108.         if tio <> NIL then begin
  109.             If OpenDevice(TIMERNAME,UNIT_VBLANK, pIORequest(tio),0) = 0 then begin
  110.                 InitTimer := True;
  111.             End;
  112.         End;
  113.     End;
  114. End;
  115.  
  116. Procedure CloseTimer;
  117.  
  118. Var
  119.     e : LONG;
  120.     
  121. begin
  122.     If CheckIO(pIORequest(tio)) = NIL then begin
  123.         AbortIO(pIORequest(tio));
  124.         e := WaitIO(pIORequest(tio));
  125.     End;
  126.     CloseDevice(pIORequest(tio));
  127.     DeleteIORequest(pIORequest(tio));
  128.     DeleteMsgPort(TimerPort);
  129. End;
  130.  
  131. Procedure SendTimer;
  132.  
  133. Begin
  134.     tio^.tr_Node.io_Command := TR_ADDREQUEST;
  135.     tio^.tr_Node.io_Flags := 0;
  136.     tio^.tr_Node.io_Error := 0;
  137.     tio^.tr_Time.tv_Secs := V.arg_Delay;
  138.     tio^.tr_Time.tv_Micro := 0; 
  139.     SendIO(pIORequest(tio));
  140. End;
  141.  
  142. Function InitInput : Boolean;
  143.  
  144. begin
  145.     InitInput := False; 
  146.     iport := CreateMsgPort;
  147.     if iport <> NIL then begin
  148.         ior := CreateIORequest(iport, Sizeof(tIORequest));
  149.         if ior <> NIL then begin
  150.             if OpenDevice('input.device', 0, ior, 0) = 0 then begin
  151.                 InputBase := pLibrary(ior^.io_Device);
  152.                 InitInput := True;
  153.             End;
  154.         End;
  155.     End;
  156. End;
  157.  
  158. Procedure FreeInput;
  159.  
  160. begin
  161.     CloseDevice(ior);
  162.     DeleteIORequest(ior);
  163.     DeleteMsgPort(iport);
  164. End;
  165.     
  166.         
  167.     
  168. Procedure Main;
  169.  
  170. Var
  171.     win : pWindow;
  172.     ok : Boolean;
  173.     dx, dy : Integer;
  174.     Timermask, CxMask, sigre,
  175.     cxtype, cxid, l : LONG;
  176.     CxMsg : pCxMsg;
  177.     Msg : pMessage;
  178.     ExitFlag, Enabled : Boolean;
  179.  
  180. Begin
  181.     IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',0));
  182.     If intuitionBase <> NIL then begin
  183.         CxBase := OpenLibrary('commodities.library',36);
  184.         If CxBase <> NIL then begin
  185.             IconBase := OpenLibrary('icon.library',0);
  186.             If IconBase <> NIL then begin
  187.                 GetToolTypes(V);
  188.                 If InitCx then begin
  189.                     If InitTimer then begin
  190.                         { reduce task priority }
  191.                         sigre := SetTaskPri(FindTask(NIL), V.arg_Pri);
  192.                         If InitInput Then begin
  193.                             SendTimer;
  194.                         
  195.                             CxMask    := BitMask(CxPort^.MP_SIGBIT);     { for Cx msgs    }
  196.                             TimerMask := BitMask(TimerPort^.MP_SIGBIT);  { for Timer msgs }
  197.  
  198.                             ExitFlag := False;
  199.                             Enabled := True;
  200.                             While Not exitflag Do Begin
  201.                                 sigre := Wait(CxMask|TimerMask|SIGBREAKF_CTRL_C);
  202.         
  203.                                 if ((sigre and SIGBREAKF_CTRL_C)=SIGBREAKF_CTRL_C) then
  204.                                     ExitFlag := True;
  205.                             
  206.                                 if ((sigre and CxMask)=CxMask) then begin
  207.                                     CxMsg := pCxMsg(GetMsg(CxPort));
  208.                                     While CxMsg <> NIL do begin
  209.                                         cxtype := CxMsgType(CxMsg);
  210.                                         cxid := CxMsgID(CxMsg);
  211.                                         ReplyMsg(pMessage(CxMsg));
  212.                                         Case cxtype of
  213.                                             CXM_COMMAND : begin
  214.                                                 case cxid of       { messages from exchange }
  215.                                                     CXCMD_DISABLE   : Enabled := False;
  216.                                                     CXCMD_ENABLE    : Enabled := True;
  217.                                                     CXCMD_KILL      : ExitFlag := True; 
  218.                                                 end;
  219.                                             end;
  220.                                             CXM_IEVENT : Begin
  221.                                                 { hotkey pressed, en/disable }
  222.                                                 If Enabled then
  223.                                                     Enabled := False
  224.                                                 else
  225.                                                     Enabled := True;
  226.                                             End;
  227.                                         end;
  228.                                         CxMsg := pCxMsg(GetMsg(CxPort));
  229.                                     end;
  230.                                 End;
  231.                         
  232.                                 if ((sigre and TimerMask)=TimerMask) then begin
  233.                                     Msg := GetMsg(TimerPort);
  234.                                     While Msg <> NIL do begin
  235.                                         If Enabled and (PeekQualifier and IEQUALIFIER_RBUTTON = 0) then begin
  236.                                             win := IntuitionBase^.FirstScreen^.FirstWindow;
  237.                                             While win <> NIL Do begin
  238.                                                 If (win^.Flags and WFLG_DRAGBAR) = WFLG_DRAGBAR then begin
  239.                                                     If (win^.Flags and WFLG_BACKDROP) <> WFLG_BACKDROP then begin
  240.                                                         If (win^.Flags and WFLG_MENUSTATE) <> WFLG_MENUSTATE then begin
  241.                                                             dx := 0; dy := 0;
  242.                                                             If win^.MouseX > 0 then
  243.                                                                 dx := V.arg_Off;
  244.                                                             If win^.MouseX < 0 then
  245.                                                                 dx := -V.arg_Off;
  246.                                                             If win^.MouseY > 0 then
  247.                                                                 dy := V.arg_Off;
  248.                                                             If win^.MouseY < 0 then
  249.                                                                 dy := -V.arg_Off;
  250.                                                             If NOT ((dy = 0) and (dx = 0)) then
  251.                                                                 MoveWindow(win, dx, dy);
  252.                                                         End;
  253.                                                     End;
  254.                                                 End;
  255.                                                 win := win^.NextWindow;
  256.                                             End;
  257.                                         End;
  258.                                         Msg := GetMsg(TimerPort);
  259.                                     End;
  260.                                     SendTimer;
  261.                                 End;
  262.                             End;
  263.                             FreeInput;
  264.                         End;
  265.                         CloseTimer;
  266.                     End;
  267.                     RemoveCx;
  268.                 End;
  269.                 CloseLibrary(pLibrary(IconBase));
  270.             End;
  271.             CloseLibrary(pLibrary(CxBase));
  272.         End;
  273.         CloseLibrary(pLibrary(IntuitionBase));
  274.     End;
  275. End;
  276.  
  277. Begin Main End.